home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pcscheme / geneva / sources.exe / SAMPLES / CONTINUE.S < prev    next >
Encoding:
Text File  |  1993-05-13  |  1.8 KB  |  75 lines
  1. ;;;
  2. ;;; Iterator maker. An iterator is a procedure that carries on a
  3. ;;; (possibly recursive) computation. Whenever it produces a result, it
  4. ;;; returns it, and saves the current state of computation. In other
  5. ;;; words, it is a corutine. It is different from a general corutine
  6. ;;; in the sense that it will only release control when it has
  7. ;;; produced a result. To see how it is used, see below.
  8. ;;;
  9.  
  10. (define (make-iterator compute . initial-arguments)
  11.   (define state #f)
  12.   
  13.   (define (go)
  14.     (call-with-current-continuation
  15.      (lambda (exit)
  16.        (define (result val)
  17.      (cond ((call-with-current-continuation
  18.          (lambda (cont)
  19.            (set! state cont)
  20.            #t))
  21.         (exit val))))
  22.        (apply compute (cons result initial-arguments)))))
  23.   
  24.   (set! state (lambda ignore (go)))
  25.   (lambda () (state #f)))
  26.  
  27. ;;;
  28. ;;; Subset maker. If you do
  29. ;;; 
  30. ;;;   (define next (subset-maker '(1 2 3)))
  31. ;;;
  32. ;;; you can get the nonempty subsets of (1 2 3) by
  33. ;;;
  34. ;;; (next) => (1)
  35. ;;; (next) => (2)
  36. ;;; (next) => (3)
  37. ;;; (next) => (2 1)
  38. ;;;  ...
  39. ;;; (next) => (1 2 3)
  40. ;;; (next) => #f
  41. ;;; (next) => #f
  42. ;;;
  43. ;;; etc.
  44. ;;;
  45.  
  46. (define (subset-maker set)
  47.  
  48.   (define (subsets result set)
  49.  
  50.     (define (combinations suffix n set)
  51.       (cond ((= (length set) n)
  52.          (result (append set suffix)))
  53.         ((= n 1)
  54.          (result (cons (car set)
  55.                suffix))
  56.          (combinations suffix n (cdr set)))
  57.         ((null? set) #f)
  58.         (else
  59.          (combinations (cons (car set) suffix)
  60.                (- n 1)
  61.                (cdr set))
  62.          (combinations suffix n (cdr set)))))
  63.  
  64.     ;; subsets
  65.     (let ((len (length set)))
  66.       (let loop ((n 1))
  67.     (if (> n len)
  68.         #f
  69.         (begin
  70.           (combinations '() n set)
  71.           (loop (+ n 1)))))))
  72.  
  73.   (make-iterator subsets set))
  74.  
  75.